perm filename RESTP2.F4[PAG,LCS] blob sn#358450 filedate 1978-06-01 generic text, type T, neo UTF8
C******* RESTP, DOUBLE **********
C THIS ROUTINE GATHERS NUMBERED RESTS AT END OF A LINE AND LATER
C INSERTS THEM AT BEGINNING OF NEXT LINE.

	SUBROUTINE RESTP
	COMMON /POSI/STFF(16),JJ2,JPQ /PX/KPN(1) /Q/Q(1)
	COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
	COMMON/XRN/RN(1) /XXX/LK,LP,JY /JN/J,N /IRST/IRST
	1 /RSP/KNM(20),ENDLN,KQ,NAME,NMPG,SPCNT
	DIMENSION MM(1),NN(1),RX(100)
	EQUIVALENCE (MX,RX),(MM,RN),(NN,RN(501))
CCC	EQUIVALENCE (MX,RX,RN(2650)),(MM,RN),(NN,RN(501))

	IF(IRST.EQ.0)GO TO 3
	IF(NN(1).NE.2)GO TO 4
C NEXT IS A REST
	IF(Q(MM(1)-3).LT.6)GO TO 4
	IF(Q(MM(1)+5).LT.-4)GO TO 4
C NEXT IS NUMBERED REST.
	Q(MM(1)+5)=Q(MM(1)+5)+RX(10)
	IRST=0
	GO TO 3

4	MX=MX-1
	CALL SHFTQ(RE)
C  PUSHES DATA TO RIGHT A BIT
	DO 9 K=KPN(JJ2-1),1,-1
9	Q(K+MX)=Q(K)
CC4	CALL RLOOP(Q(MX),Q,KPN(JJ2-1))
	LX=RX(MX+2)
C  THE WD CNT
CC	MX=MX-1
	RX(5)=ENDLN
10	CALL RLOOP(Q,RX(2),MX)
	DO 5 K=N,1,-1
	J=K+LX
	NN(J)=NN(K)
	MM(J)=MM(K)+MX
C  SHIFT EVERYTHING
5	KPN(J)=KPN(K)+MX
	N=N+LX
	JJ2=JJ2+LX
	KQ=KQ+MX
	J=2
	K=2
6	M=RX(K)+3
	KPN(J)=KPN(J-1)+M
	J=J+1
	K=K+M
	IF(K.LT.MX)GO TO 6
	IRST=0
	DO 7 K=1,LX
	MM(K)=KPN(K)+3
C  ASSUMES NO SLURS, HORIZ. LINES, ETC. AT THIS POINT.
7	NN(K)=CODEN(KPN,K,Q,J)

3	DO 1 K=N,1,-1
	J=NN(K)
	IF(J.GT.16)RETURN
	IF(J.EQ.1)RETURN
	IF(Q(MM(K)+1).GE.1000)RETURN
C  NO RESTS COMBINED OVER DOUBLE BARS.
	IF(J.NE.2)GO TO 1
	M=MM(K)
	IF(Q(M-3).LT.6)RETURN
	IF(Q(M+5).LT.-4)RETURN
C AVOID REPEAT BAR SIGN (P8=-5)
	IRST=-1
C  NOW FOUND NUMBERED REST
	IF(K.NE.1)GO TO 8
	IRST=-2
C  -2 = ONLY RESTS ON THIS LINE.
8	M=1
	RE=ENDLN+3
	DO 20 J=K,N
CC 1/78 	IF(NN(J).EQ.0)GO TO 2
C  DO I NEED THIS??
	JX=MM(J)
CC	Q(JX)=Q(JX)-200
	Q(JX)=RE
	RE=RE+3
	LX=Q(JX-3)+3
	JX=JX-4
	DO 2 JA=1,LX
	M=M+1
2	RX(M)=Q(JA+JX)
20	CONTINUE
	MX=M
C WD CNT
	JJ2=JJ2-N+K-1
	RX(M+1)=N-K+1
	N=K-1
	IF(IRST.EQ.-2)N=-N
	RETURN
1	CONTINUE
	END
 
	SUBROUTINE DOUBLE
	COMMON/STF/RSTFAC(0/15),RSTJ2 /POSI/STFF(0/15),JJ2,JPQ
	COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX,EXT
	1 /PTR/KWDS(1)/LLL/L,LL,I,IX,XSIG /DREAD/DREAD(0/16),JREAD,KREAD
	1 /RSP/KNM(20),ENDLN,KQ,NAME,NMPG,SPCNT,LASTNM
	JJ2=JJ2-2
	DO 1 K=1,JJ2 
	J=KWDS(K)
1	RN(J+2)=RN(J+2)+8.
186	FORMAT(1XA5,'.',A3)
	NAME=NAME+2
	KNM(1)=NAME
	TYPE 186,NAME,EXT
	I=JPQ
	ITEM=JJ2+1
3	CALL GETEXT(NAME,EXT)
C  LP IS START OF RN ARRAY THIS TIME
	CALL EXTIN(DREAD,20)
	DO 3001 K=0,7
	RSTFAC(K+8)=DREAD(K)
3001	STFF(K+8)=DREAD(K+9)
	JJ2=JREAD
	JPQ=KREAD
	CALL EXTIN(KWDS(ITEM),JJ2)
	CALL EXTIN(RN(I),JPQ)
	JJ2=JJ2+ITEM
	KP=I-1
	DO 4 K=ITEM,JJ2
4	KWDS(K)=KWDS(K)+KP
2	JPQ=JPQ+I
	END